Bank Marketing Exploratory Analysis

library(tidyverse)
library(stringr)
library(ggplot2)
library(dygraphs)
library(xts)
library(plotly)

Download data

We are working with a dataset from a Portuguese bank. The data categorizes direct marketing efforts (phone calls) designed to sell term deposit products. The dataset was donated to UCI’s Machine Learning Repository. The goal is to predict which clients are most likely to subscribe to a term deposit. Data range from May 2008 to November 2010

download.file(url = "https://archive.ics.uci.edu/ml/machine-learning-databases/00222/bank-additional.zip",
              destfile = "data/bank-additional.zip")

trying URL 'https://archive.ics.uci.edu/ml/machine-learning-databases/00222/bank-additional.zip'
Content type 'application/zip' length 444572 bytes (434 KB)
==================================================
downloaded 434 KB

unzip(zipfile = "data/bank-additional.zip", 
      exdir = "data", 
      files = "bank-additional/bank-additional-full.csv", 
      junkpaths = TRUE)

Read data

Read data and clean up column names. Remove unnecessary columns and records. Impute year and create a column for date.

raw_data <- read_delim(file = "data/bank-additional-full.csv", 
                       delim = ";", 
                       col_types = cols(nr.employed = col_number()),
                       progress = FALSE) 

Error in read_delim(file = "data/bank-additional-full.csv", delim = ";",  : 
  could not find function "read_delim"

Insights

There were far more contacts in 2008 and 2009.

# Monthly rollup
dat <- all_data %>%
  group_by(month_idx, year, month, date) %>%
  summarize(subscribe = sum(term_deposit == "yes"), 
            total = n(),
            percent = 100 * mean(term_deposit == "yes"))
# Percent
xts(dat$percent, dat$date) %>%
  dygraph(main = "Percent subscribing") %>%
  dyRangeSelector()

# Totals
with(dat, xts(cbind(Total = total, Subscribe = subscribe), date)) %>%
  dygraph(main = "Total contacts and subscriptions") %>%
  dyRangeSelector()

Term deposits are correlated to some extent with macro economic indicators.

p <- all_data %>%
  group_by(month_idx, year, month) %>%
  summarize(euribor3m = mean(euribor3m),
            cons_conf_idx = mean(cons_conf_idx),
            cons_price_idx = mean(cons_price_idx),
            term_deposit = 100 * mean(term_deposit == "yes")) %>%
  ungroup %>%
  mutate_at(vars(euribor3m, cons_conf_idx, cons_price_idx),
                 function(x) (x - min(x)) / (max(x) - min(x))) %>%
  gather("key", "value", euribor3m, cons_conf_idx, cons_price_idx)
ggplot(p, aes(month_idx, value, color = key)) +
  geom_line() +
  ggtitle("Economic Indicators") +
  xlab("Month") +
  ylab("Index")

ggplot(p, aes(term_deposit, value, color = year)) +
  geom_point() +
  facet_grid(~key) +
  ggtitle("Economic Indicators vs Term Deposits") +
  xlab("Term Depoist Percent") +
  ylab("Index")

Lower rates of euribor3m were associated with associated with more term desposits.

ggplot(all_data, aes(euribor3m, color = term_deposit)) +
  geom_density(adjust=0.05)

Clients with a successful prior outcome were much more likley to subscribe to a term deposit.

all_data %>%
  group_by(term_deposit) %>%
  count(prior_outcome) %>%
  mutate(pct = round(100 * n / sum(n), 1)) %>%
  select(-n) %>%
  spread(term_deposit, pct)

Contacts who subscribe to term deposits skew slightly older and younger.

qplot(term_deposit, age, data = all_data, geom = "boxplot")

October saw an unusually high percent of term deposits in 2008.

p <- all_data %>%
  group_by(year, month) %>%
  summarize(term_deposit = 100 * mean(term_deposit == "yes")) %>%
  ggplot(aes(month, term_deposit, fill = year)) +
  geom_bar(stat = "identity", position="dodge")
ggplotly(p)

Blue collar workers are less likely to subscribe.

all_data %>%
  group_by(term_deposit) %>%
  count(job) %>%
  mutate(pct = round(100 * n / sum(n), 1)) %>%
  select(-n) %>%
  spread(term_deposit, pct)

There were far more contacts in 2008 than in 2010

all_data %>%
  group_by(year, month) %>%
  summarize(term_deposit = sum(term_deposit == "yes"), count = n()) %>%
  ggplot(aes(count, term_deposit, color = year)) +
  geom_point() +
  xlab("Total contacts") +
  ylab("Term Deposit Subscriptions") +
  ggtitle("Contact volume")

Conclusions

There is a lot of variability in total contacts and in percentage of term deposit subscriptions over time. There were far more contacts made in 2008 when the three month Euribor rate was high. As total contacts dropped, the percentage of term deposit subsriptions increased.

Subscriptions are correlated with a variety of factors, including age and job to name a few. There is also a strong correlation with prior outcomes, as one might expect.

This analysis only analyzed a few select variables. The next goal should be to predict term deposit subscriptions as a function of all the variables in the data.